The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package CSS::Packer;

use 5.008;
use warnings;
use strict;
use Carp;

use vars qw/$VERSION $RULE $DECLARATION $COMMENT $CHARSET $MEDIA $IMPORT $PLACEHOLDER/;

$VERSION = '0.2';

$RULE = qr/([^{}~;]+)\{([^{}]*)\}/;

$IMPORT = qr/\@import\s+("[^"]+"|'[^']+'|url\(\s*"[^"]+"\s*\)|url\(\s*'[^']+'\s*\)|url\(\s*[^'"]+?\s*\))(.*?);/;

$MEDIA = qr/\@media([^{}]+){((\s*$IMPORT|$RULE)+)\s*}/;

$DECLARATION = qr/((?>[^;:]+)):(?<=:)((?>[^;]*));/;

$COMMENT = qr/(\/\*[^*]*\*+([^\/][^*]*\*+)*\/)/;

$CHARSET = qr/^(\@charset)\s+("[^"]*";|'[^']*';)/;

$PLACEHOLDER = qr/(?>[^~]*)(~(iec_start|iec_end|charset|import_\d+|media_\d+|rule_\d+)~)(?>[^~]*)/;

# -----------------------------------------------------------------------------

sub minify {
	my ( $scalarref, $opts ) = @_;
	
	if ( ref( $scalarref ) ne 'SCALAR' ) {
		carp( 'First argument must be a scalarref!' );
		return '';
	}
	
	return '' if ( ${$scalarref} eq '' );
	
	if ( ref( $opts ) ne 'HASH' ) {
		carp( 'Second argument must be a hashref of options! Using defaults!' ) if ( $opts );
		$opts = { 'compress' => 'pretty' };
	}
	else {
		$opts->{'compress'} = grep( $opts->{'compress'}, ( 'minify', 'pretty' ) ) ? $opts->{'compress'} : 'pretty';
	}
	
	$opts = { 'compress' => 'pretty' } if ( ref( $opts ) ne 'HASH' or $opts->{'compress'} ne 'minify' );
	
	${$scalarref} =~ s/~iec_start~/ /gsm;
	${$scalarref} =~ s/~iec_end~/ /gsm;
	
	${$scalarref} =~ s/~charset~/ /gsm;
	${$scalarref} =~ s/~import_\d+~/ /gsm;
	${$scalarref} =~ s/~media_\d+~/ /gsm;
	${$scalarref} =~ s/~rule_\d+~/ /gsm;
 	${$scalarref} =~ s/\r//gsm;
	
	my $charset	= '';
	my $import	= [];
	my $media	= [];
	my $rule	= [];
	
	my $_do_declaration = sub {
		my ( $key, $value ) = @_;
		
		$key	=~ s/^\s*|\s*$//gs;
		$value	=~ s/^\s*|\s*$//gs;
		
		if ( $key eq 'content' ) {
			my @strings;
			my $_do_content = sub {
				my $string = shift;
				
				my $ret = '~string_' . scalar( @strings ) . '~';
				
				push( @strings, $string );
				
				return $ret;
			};
			
			$value =~ s/"(\\.|[^"\\])*"/&$_do_content( $& )/egs;
			
			$value =~ s/(?>\s+)(~string_\d+~)/$1/gsm;
			$value =~ s/(~string_\d+~)(?>\s+)/$1/gsm;
			
			$value =~ s/~string_(\d+)~/$strings[$1]/egsm;
		}
		else {
			$value =~ s/\s*,\s*/,/gsm;
			$value =~ s/\s+/ /gsm;
		}
		
		return '' if ( not $key or ( not $value and $value ne '0' ) );
		
		return $key . ':' . $value . ';' . ( $opts->{'compress'} eq 'pretty' ? "\n" : '' );
	};
	
	my $_do_rule = sub {
		my ( $selector, $declaration ) = @_;
		
		$selector =~ s/^\s*|\s*$//gs;
		$selector =~ s/\s*,\s*/,/gsm;
		$selector =~ s/\s+/ /gsm;
		
		$declaration =~ s/^\s*|\s*$//gs;
		
		$declaration =~ s/$DECLARATION/&$_do_declaration( $1, $2 )/egsm;
		
		my $ret = '~rule_' . scalar( @{$rule} ) . '~';
		
		my $store = $selector . '{' . ( $opts->{'compress'} eq 'pretty' ? "\n" : '' ) . $declaration . '}' . ( $opts->{'compress'} eq 'pretty' ? "\n" : '' );
		
		$store = '' unless ( $selector or $declaration );
		
		push( @{$rule}, $store );
		
		return $ret;
	};
	
	my $_do_import = sub {
		my ( $file, $mediatype ) = @_;
		
		if ( $file =~ /^("|')(?>\s*)(.*?)(?>\s*)\1$/ ) {
			$file = $1 . $2 . $1;
		}
		elsif ( $file =~ /^url\(\s*("|')(?>\s*)(.*?)(?>\s*)\1\s*\)$/ ) {
			$file = 'url(' . $1 . $2 . $1 . ')';
		}
		elsif ( $file =~ /^url\((?>\s*)(.*?)(?>\s*)\)$/ ) {
			$file = 'url(' . $1 . ')';
		}
		else {
			$file = '';
		}
		
		my $store = '@import ' . $file;
		
		if ( $mediatype ) {
			$mediatype =~ s/^\s*|\s*$//gs;
			$mediatype =~ s/\s*,\s*/,/gsm;
			
			$store .= $mediatype;
		}
		
		$store .= ';' . ( $opts->{'compress'} eq 'pretty' ? "\n" : '' );
		
		my $ret = '~import_' . scalar( @{$import} ) . '~';
		
		push( @{$import}, $store );
		
		return $ret;
	};
	
	my $iec_isopen = 0;
	
	my $_do_comment = sub {
		my $comment = shift;
		
		if ( $comment =~ /\\\*\/$/ and not $iec_isopen ) {
			$iec_isopen = 1;
			return '~iec_start~';
		}
		elsif ( $comment !~ /\\\*\/$/ and $iec_isopen ) {
			$iec_isopen = 0;
			return '~iec_end~';
		}
		
		return ' ';
	};
	
	my $_do_charset = sub {
		my ( $selector, $declaration ) = @_;
		
		$charset = $selector . " " . $declaration . ( $opts->{'compress'} eq 'pretty' ? "\n" : '' );
		
		return '~charset~';
	};
	
	my $_do_media = sub {
		my ( $mediatype, $mediarules ) = @_;
		
		$mediatype =~ s/^\s*|\s*$//gs;
		$mediatype =~ s/\s*,\s*/,/gsm;
		
		$mediarules =~ s/$IMPORT/&$_do_import( $1, $2 )/egsm;
		$mediarules =~ s/$RULE/&$_do_rule( $1, $2 )/egsm;
		
		$mediarules =~ s/$PLACEHOLDER/$1/gsm;
		
		my $ret = '~media_' . scalar( @{$media} ) . '~';
		
		my $store = '@media ' . $mediatype . '{' . ( $opts->{'compress'} eq 'pretty' ? "\n" : '' ) .
			$mediarules . '}' . ( $opts->{'compress'} eq 'pretty' ? "\n" : '' );
		
		push( @{$media}, $store );
		
		return $ret;
	};
	
	${$scalarref} =~ s/$CHARSET/&$_do_charset( $1, $2 )/emos;
	
	${$scalarref} =~ s/$COMMENT/&$_do_comment( $& )/egsm;
	
	${$scalarref} =~ s/$MEDIA/&$_do_media( $1, $2 )/egsm;
	
	${$scalarref} =~ s/$IMPORT/&$_do_import( $1, $2 )/egsm;
	
	${$scalarref} =~ s/$RULE/&$_do_rule( $1, $2 )/egsm;
	
	${$scalarref} =~ s/$PLACEHOLDER/$1/gsm;
	
	${$scalarref} =~ s/~media_(\d+)~/$media->[$1]/egsm;
	${$scalarref} =~ s/~rule_(\d+)~/$rule->[$1]/egsm;
	${$scalarref} =~ s/~import_(\d+)~/$import->[$1]/egsm;
	${$scalarref} =~ s/~charset~/$charset/gsm;
	
	${$scalarref} =~ s/~iec_start~/sprintf( '\/*\\*\/%s', $opts->{'compress'} eq 'pretty' ? "\n" : '' )/egsm;
	${$scalarref} =~ s/~iec_end~/sprintf( '\/**\/%s', $opts->{'compress'} eq 'pretty' ? "\n" : '' )/egsm;
	
	${$scalarref} =~ s/\n$//s unless ( $opts->{'compress'} eq 'pretty' );
}

1;

__END__

=head1 NAME

CSS::Packer - Another CSS minifier

=head1 VERSION

Version 0.2

=head1 SYNOPSIS

    use CSS::Packer;

    CSS::Packer::minify( $scalarref, $opts );

=head1 DESCRIPTION

A fast pure Perl CSS minifier.

=head1 FUNCTIONS

=head2 CSS::Packer::minify( $scalarref, $opts );

First argument must be a scalarref of CSS-Code.
Second argument must be a hashref of options. The only option is

=over 4

=item compress

Defines compression level. Possible values are 'minify' and 'pretty'.
Default value is 'pretty'.

'pretty' converts

    a {
    color:          black
    ;}   div
    
    { width:100px;
    }

to

    a{
    color:black;
    }
    div{
    width:100px;
    }

'minify' converts the same rules to

    a{color:black;}div{width:100px;}

=back

=head1 AUTHOR

Merten Falk, C<< <nevesenin at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-css-packer at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CSS-Packer>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

perldoc CSS::Packer

=head1 COPYRIGHT & LICENSE

Copyright 2008 Merten Falk, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 SEE ALSO

L<CSS::Minifier>,
L<CSS::Minifier::XS>

=cut